フォルダ・ファイル(ブック)操作



ドライブ、フォルダの操作
処理内容:C ドライブに新規にフォルダ「Text」を作成します。
Sub folder_1()
MkDir "C:¥Text"
End Sub
処理内容:C ドライブのフォルダ「Text」を削除します。
Sub folder_2()
RmDir "C:¥Text"
End Sub
処理内容:アクティブフォルダの属性をメッセージボックスに表示します。
Sub folder_3()
MsgBox GetAttr(CurDir)
End Sub
|
4. カレントディレクトリ(カレントフォルダ名)を取得する |
処理内容:アクティブフォルダ名をメッセージボックスに表示します。
Sub folder_4
MsgBox CurDir
End Sub
処理内容:現在のドライブからFDドライブに変更します。
Sub folder_5()
ChDrive "A"
End Sub
処理内容:現在のアクティブフォルダを「VBA」というフォルダに変更します。
Sub folder_6()
ChDir "C:¥VBA"
End Sub
処理内容:フォルダ名を「VBA」から「VBAMacro」に変更します。
Sub folder_7()
Name "C:¥VBA" AS "C:¥VBAMacro"
End Sub
現在、開いているファイルに対して Nameステートメントを実行するとエラーが発生します。
ファイル名を変える前に、開いているファイルを閉じて下さい。



ファイルの新規作成
|
1. 既定のファイル(ブック)名で新規ブックを作成する |
処理内容:ブック名を指定せず、既定のブック名で新規にブックを作成します。
Sub Book_1()
Workbooks.Add
End Sub
作成されるブック名は、「Book2」のようになります。
|
2. ファイル(ブック)名を指定して新規ファイルを作成 |
処理内容:「新規ブック」というファイル名を付けて新規ファイルを作成します。
Sub Book_2()
Dim Newbook As Workbook
Set Newbook = Workbooks.Add
Newbook.SaveAs FileName:="新規ブック"
End Sub
|
3.
フォルダに指定したファイルがないときは新規ファイルを作成 |
処理内容:フォルダ内に指定した名前のファイルがあれば開き、なければ新規作成します。
Sub Book_3()
Application.DisplayAlerts = False '確認ダイアログを表示させない
Application.ScreenUpdating = False '画面更新を中断する<
On Error GoTo Err_chek
' フォルダ「MyData」に指定したファイルがあるとき、ファイルを展開する
Workbooks.Open Filename:="D:¥MyData¥TEST.xls", UpdateLinks:=0
Goto Owari
Err_chek:
' フォルダ「MyData」に指定したファイルがないとき、ファイルを新規作成して名前を付ける
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="D:¥MyData¥TEST.xls"
Owari:
Application.DisplayAlerts = True '確認ダイアログを表示する
Application.ScreenUpdating = True '画面更新を再開する
End Sub
Application.DisplayAlerts と Application.ScreenUpdatingの処理は無くてもかまいません。



ファイルの展開
処理内容:カレントドライブをDドライブに変更してから「VBA_PartsCollection」というファイルを展開します。
Sub BookOpen_1()
ChDir "D:"
Workbooks.Open Filename:="VBA_PartsCollection.xls"
End Sub
処理内容:「C」ドライブの「VbaMacro」フォルダにある「ExcelVBA」というファイルを展開します。
Sub BookOpen_2()
Workbooks.Open Filename:="C:¥VbaMacro¥ExcelVBA.xls"
End Sub
処理内容:アクティブフォルダの中の「ExcelVBA」というファイルを展開します。
Sub BookOpen_3()
Workbooks.Open Filename:="ExcelVBA.xls"
End Sub
処理内容:現在アクティブフォルダの中の「ExcelVBA」というファイルを展開します。
Sub BookOpen_4()
Workbooks.Open "ExcelVBA"
End Sub
|
5.
現在のブックをそのままにして新しくファイルを開く |
処理内容:現在開かれているファイルを閉じずに、新しく「ExcelVBA」というファイルを展開し、元のファイルをアクティブにします。
Sub BookOpen_5()
Dim bkName As String
bkName = ActiveWorkbook.Name
Workbooks.Open "ExcelVBA.xls"
Workbooks(bkName).Activate
End Sub
|
6. 同じフォルダ内にあるExcelファイルを検索して開く |
処理内容:同じフォルダにあるファイルを順次検索して、Excelファイル(xlsの拡張子がついているファイル)があれば開くかどうかを確認してから展開します。また、開いたファイルを閉じるときも確認してから閉じます。
Sub BookOpen_6()
Dim myPath As String
Dim myFName As String
Workbooks("Book1.xls").Activate
myPath = ActiveWorkbook.Path
ChDir myPath
myFName = Dir("*.xls")
Do Until myFName = ""
Rec = MsgBox(myFName & "を開きますか", vbYesNo)
If Rec = vbYes Then
Workbooks.Open Filename:=myFName
Rec = MsgBox(myFName & "を閉じますか", vbYesNo)
If Rec = vbYes Then
Workbooks(myFName).Close SaveChanges:=True
End If
End If
myFName = Dir()
Loop
End Sub
|
7. 指定したフォルダ内にあるExcelファイルを検索して開く |
処理内容:指定したフォルダにあるファイルを順次検索して、Excelファイル(xlsの拡張子がついているファイル)があれば開くかどうかを確認してから展開します。
Sub BookOpen_7()
Dim i As Long
Dim FName As String
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "D:¥MyData"
.SearchSubFolders = False 'サブフォルダは検索しない
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
FName = .FoundFiles(i)
Rec = MsgBox(FName & "を開きますか", vbYesNo)
If Rec = vbYes Then
Workbooks.Open FName
End if
Next i
Else
MsgBox "対象ファイルはありませんでした"
End if
End With
Application.ScreenUpdating = True
End Sub
|
8. FDのExcelファイルの名前を確認して開く |
処理内容:フロッピーディスクにあるファイルを順次検索して、Excelファイル(xlsの拡張子がついているファイル)があれば開くかどうかを確認してから展開します。
Sub BookOpen_8()
Dim Filename As String
Filename = Dir("A:¥*.xls", vbNormal)
Do While Filename <> ""
Msg = "検索したファイル名 = " & Filename & vbCrLf & vbCrLf & _
"このファイルを開きますか"
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "ファイル名確認"
MsgRec = MsgBox(Msg, Style, Title)
If MsgRec = vbYes Then
ChDir "A:¥"
Workbooks.Open "A:¥" & Filename
End If
Filename = Dir()
Loop
End Sub
処理内容:既に開かれている「Book1」をアクティブにします。
Sub BookOpen_9()
Workbooks("Book1").Activate
End Sub



ファイルの検索
|
1. カレントドライブに有るファイルを検索してセルに表示 |
処理内容:カレントドライブ(現在開かれているフォルダ)のExcelファイルを順次検索して、ファイル名、サイズ、更新日時をセルに表示します。
Sub BookSearch_1()
Dim Fn As String
Dim i As Integer
Fn = Dir("*.xls", 0)
i = 1
Do Until Fn = ""
Cells(i, 1).Value = Fn
Cells(i, 2).Value = FileLen(Fn)
Cells(i, 3).Value = FileDateTime(Fn)
i = i + 1
Fn = Dir()
Loop
End Sub
|
2.
同じ名前のファイルがあるかどうかチェックする |
処理内容:カレントドライブ(現在開かれているフォルダ)を検索して、同じ名前のファイルがあれば「同名のブックがあります」、なければ「同名のブックはありません」とメッセージボックスに表示します。
Sub BookSearch_2()
Dim BookName As String
Dim wb As Workbook
BookName = "VBA_PartsCollection.xls"
On Error Resume Next
Set wb = Workbooks(BookName)
On Error GoTo 0
If Not (wb Is Nothing) Then
MsgBox "同名のファイルがあります。"
Else
MsgBox "同名のファイルはありません。"
End If
Set wb = Nothing
End Sub



ファイルの属性の取得・設定
処理内容:ファイル名「Text」の属性を「通常ファイル」に設定します。
なお、開いているファイルの属性を変更しようとすると実行時エラーが発生します。
Sub BookPath_1()
SetAttr "Test.xls",vbNormal 'ファイル名,属性
End Sub
定数(値) 内容
vbNormal (0) (既定値)通常ファイル
vbReadOnly (1) 読み取り専用ファイル
vbHidden (2) 隠しファイル
vbSystem (4) システムファイル。Macintoshでは使用できません。
vbArchive (32) アーカイブ(属性最後にバックアップした後で、変更されたファイル)
vbAlias (64) エイリアスファイル。Macintoshでのみ使用できます。
定数、値( )内の数値のどちらかを使用して設定します。
処理内容:「D」ドライブの「MyData」フォルダにある「Test」ファイルのフルパス、パス、ファイル名、属性をセルに表示します。
Sub BookPath_2()
Cells(1,1).value = ThisWorkbook.FullName 'D:¥MyData¥Test.xls
Cells(2,1).value = ThisWorkbook.Path 'D:¥MyData
Cells(3,1).value = ActiveWorkbook.Name 'Test.xls
Cells(4,1).value = GetAttr("Test.xls") '32
End Sub



ファイルを保存・閉じる
処理内容:現在、開かれているファイルを同名で上書き保存します。
Sub book_SaveClose1()
ActiveWorkbook.Save
End Sub
処理内容:現在開かれてはいるが、アクティブでないファイルを上書き保存します。
Sub book_SaveClose2()
Workbooks("VBAMACRO.xls").Save
End Sub
|
3. ファイルをDドライブに新規保存(名前を付けて保存) |
処理内容:新規作成したファイルをDドライブに新規保存します。
Sub book_SaveClose3()
ActiveWorkbook.SaveAs Filename:="D:¥ExcelVBA Note.xls"
End Sub
処理内容:現在開かれているファイルを上書き保存してから閉じます。
Sub book_SaveClose4()
ActiveWorkbook.Close SaveChanges:=True
End Sub
処理内容:現在開かれているファイルをフロッピーディスクに保存します。
Sub book_SaveClose5()
ChDir "A:¥"
ActiveWorkbook.SaveAs Filename:="A:¥ExcelVBA Note.xls", _
FileFormat:=xlNormal
End Sub
|
6.
変更があった場合のみファイルを保存して閉じる |
処理内容:ファイルのデータ内容に変更があったときだけ保存し、変更がないときは保存しないで閉じます。
Sub book_SaveClose6()
With ActiveWorkbook
If .Saved = True Then
.Close False
Else
.Close True
End If
End With
End Sub
処理内容:ファイル「ExcelVBA Index.xls」を閉じます。
Sub book_SaveClose7()
Workbooks("ExcelVBA Index.xls").Close
End Sub
処理内容:現在開かれて入るファイルを閉じます。
Sub book_SaveClose8()
ActiveWorkbook.Close
End Sub
処理内容:開かれた順番(プログラムでは2番目)を指定してファイルを閉じます。
Sub book_SaveClose9()
Workbooks(2).Close
End Sub
処理内容:「"ファイル名"の変更を保存しますか」のメッセージを表示しないでファイルを閉じます。
Sub book_SaveClose10()
Workbooks("ExcelVBA Index.xls").Close SaveChanges:=True
End Sub
処理内容:ファイルを保存しないでそのまま閉じます。
Sub book_SaveClose11()
Workbooks("ExcelVBA Index.xls").Close False
End Sub
処理内容:現在開かれているすべてのワークブックを閉じます。
Sub book_SaveClose12()
Workbooks.Close
End Sub
処理内容:Excelアプリケーションの終了。
Sub book_SaveClose13()
Application.Quit
End Sub



ファイルを変更・複写・移動・保護・削除
処理内容:「変更前ファイル名」から「変更後ファイル名」にファイルの名前を変更する。
Sub File_Change1()
Name "C:¥変更前ファイル名.xls" As "C:¥変更後ファイル名.xls"
End Sub
|
2. ファイルを異なるフォルダに複写する(ファイル名も変更) |
処理内容:フォルダ名「F1」のファイル名「B1」をフォルダ名「F2」に複写し、同時にファイル名も「B2」に変更します。
Sub File_Change2()
FileCopy "C:¥F1¥B1.xls" , "C:¥F2¥B2.xls" '左が複写元、右が複写先
End Sub
|
3. ファイルをFDに複写する(ファイル名はそのまま) |
処理内容:Cドライブのフォルダ名「MyData」にあるファイル名「Book1.xls」をフロッピディスクに複写します。
Sub File_Change3()
FileCopy "C:¥MyData¥Book1.xls" , "A:¥Book1.xls" '左が複写元、右が複写先
End Sub
|
4. ファイルをFDに複写する(ファイル名も変更) |
処理内容:Cドライブのフォルダ名「MyData」にあるファイル名「Book1.xls」をフロッピディスクに複写します。同時にファイル名も変更します。
Sub File_Change4()
FileCopy "C:¥MyData¥Book1.xls" , "A:¥Book2.xls" '左が複写元、右が複写先
End Sub
処理内容:Cドライブのフォルダ名「MyData」にあるファイル名「Book1.xls」を「F2」フォルダに移動します。
Sub File_Change5()
Name "C:¥MyData¥Book1.xls" As "C:¥F2¥Book1.xls" '左が移動元、右が移動先
End Sub
|
6. ブックを異なるフォルダに移動してファイル名を変更する |
処理内容:Cドライブのフォルダ名「MyData」にあるファイル名「Book1.xls」を「F2」フォルダに移動してファイル名も「Book1.xls」から「Book2」に変更します。
Sub File_Change6()
Name "C:¥MyData¥Book1.xls" As "C:¥F2¥Book2.xls" '左が移動元、右が移動先
End Sub
処理内容:Cドライブのファイル名「Book1.xls」をフロッピーディスクに移動します。
Sub File_Change7()
Name "C:¥Book1.xls" As "A:¥Book1.xls" '左が移動元、右が移動先
End Sub
処理内容:ファイルに保護をかけます。
Sub File_Change8()
ActiveWorkbook.Protect Structure:=True, Windows:=False
End Sub
処理内容:保護が掛かっているファイルを非保護にします。
Sub File_Change9()
ActiveWorkbook.Unprotect
End Sub
Cドライブのファイル「Book1.xls」を削除します。
Sub File_Change10()
Kill "C:¥Book1.xls"
End Sub


